home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / oop.swg / 0039_INI files in TV-OWL.pas < prev    next >
Pascal/Delphi Source File  |  1994-05-26  |  24KB  |  927 lines
  1. {$A+,F+,I-,R-,S-,V-}
  2.  
  3. unit IniTV;  {unit for managing INI files using TurboVision/OWL}
  4.  
  5. {*********************************************}
  6. {*              INITV.PAS  1.04              *}
  7. {*      Copyright (c) Steve Sneed 1993       *}
  8. {*********************************************}
  9.  
  10. {*
  11. NOTE: This code was quickly adapted from some using Object Professional's
  12. DoubleList object.
  13. *}
  14.  
  15. {$IFNDEF Ver70}
  16.   !! STOP COMPILE: This unit requires BP7 !!
  17. {$ENDIF}
  18.  
  19. {if Object Professional is available, use its string routines}
  20. {.$DEFINE UseOPro}
  21.  
  22. interface
  23.  
  24. uses
  25. {$IFDEF UseOPro}
  26.   OpString,
  27. {$ENDIF}
  28.   Objects;
  29.  
  30. const
  31.   EncryptionKey : String[80] = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ';
  32.   FBufSize = 4096;
  33.  
  34. type
  35.   PLine = ^TLine;
  36.   TLine =
  37.     object(TObject)
  38.       PL : PString;
  39.  
  40.       constructor Init(S : String);
  41.       destructor Done; virtual;
  42.       procedure Update(S : String);
  43.     end;
  44.  
  45.  
  46.   PIni = ^TIni;
  47.   TIni =
  48.     object(TCollection)
  49.       IniName   : String;
  50.       FBufr     : PChar;
  51.  
  52.       constructor Init(ALimit, ADelta : Integer;
  53.                        FN : String;
  54.                        Sparse, Create : Boolean);
  55.         {-Construct our INI file object.  if Sparse=True, load only "active"
  56.           lines (file is considered read-only.)  File always updates on
  57.           changes; use SetFlushMode to control.}
  58.       destructor Done; virtual;
  59.         {-Destroy object when done}
  60.       procedure Reload;
  61.         {-Reload the INI file after it may have changed externally}
  62.       procedure FlushFile;
  63.         {-Force an update of the physical file from the current list}
  64.       procedure SetFlushMode(Always : Boolean);
  65.         {-Turn off/on auto-updating of file when an item is modified}
  66.       procedure SetExitFlushMode(DoIt : Boolean);
  67.         {-Turn off/on updating of file when the object is disposed}
  68.       function GetProfileString(Title, Group, Default : String) : String;
  69.         {-Return string item "Title" in "[Group]", or default if not found}
  70.       function GetEncryptedProfileString(Title, Group, Default : String) : String;
  71.         {-Same as GetProfileString but decrypts the found string}
  72.       function GetProfileBool(Title, Group : String; Default : Boolean) : Boolean;
  73.         {-Return boolean item "Title" in "[Group]", or default if not found}
  74.       function GetProfileByte(Title, Group : String; Default : Byte) : Byte;
  75.         {-Return byte item "Title" in "[Group]", or default if not
  76.           found or Not A Number}
  77.       function GetProfileInt(Title, Group : String; Default : Integer) : Integer;
  78.         {-Return integer item "Title" in "[Group]", or default if not
  79.           found or NAN}
  80.       function GetProfileWord(Title, Group : String; Default : Word) : Word;
  81.         {-Return word item "Title" in "[Group]", or default if not
  82.           found or NAN}
  83.       function GetProfileLong(Title, Group : String; Default : LongInt) : LongInt;
  84.         {-Return longint item "Title" in "[Group]", or default if not
  85.           found or NAN}
  86.       function SetProfileString(Title, Group, NewVal : String) : Boolean;
  87.         {-Change existing item "Title" in "[Group]" to "NewVal"}
  88.       function SetEncryptedProfileString(Title, Group, NewVal : String) : Boolean;
  89.         {-Change existing item "Title" in "[Group]" to "NewVal"}
  90.       function AddProfileString(Title, Group, NewVal : String) : Boolean;
  91.         {-Add new item "Title=NewVal" to "[Group]".  Creates [Group] if not
  92.           found or if "Title" = '', else adds "Title=NewVal" as last item in
  93.           [Group]}
  94.       function AddEncryptedProfileString(Title, Group, NewVal : String) : Boolean;
  95.         {-Same as AddProfileString but encrypts "NewVal" when adding}
  96.       function KillProfileItem(Title, Group : String) : Boolean;
  97.         {-Completely remove the "Title" entry in "[Group]"}
  98.       function KillProfileGroup(Group : String) : Boolean;
  99.         {-Kill the entire group "[Group]", including group header}
  100.       function EnumGroups(P : PStringCollection; Clr : Boolean) : Boolean;
  101.         {-Return P loaded with the names of all groups in the file.  Returns
  102.           false only on error.  On return P is in file order rather than
  103.           sorted order.}
  104.       function EnumGroupItems(P : PStringCollection; Group : String; Clr : Boolean) : Boolean;
  105.         {-Return P loaded with all items in group [Group].  Returns false
  106.           if Group not found or error.  On return P is in file order rather
  107.           than sorted order}
  108.  
  109.     private  {these used internally only}
  110.       IniF      : Text;
  111.       NeedUpd   : Boolean;
  112.       AlwaysUpd : Boolean;
  113.       IsSparse  : Boolean;
  114.       ExitFlush : Boolean;
  115.  
  116.       function GetIniNode(Title, Group : String) : PLine;
  117.       function GetLastNodeInGroup(Group : String) : PLine;
  118.       function GetProfilePrim(Title, Group : String) : String;
  119.     end;
  120.  
  121. procedure SetEncryptionKey(NewKey : String);
  122.   {-define the encryption key}
  123.  
  124. implementation
  125.  
  126.   function NewStr(const S: String): PString;
  127.     {-NOTE: The default NewStr returns a nil pointer for empty strings.  This
  128.       will cause problems, so we define a NewStr that always allocates a ptr.}
  129.   var
  130.     P: PString;
  131.   begin
  132.     GetMem(P, Length(S) + 1);
  133.     P^ := S;
  134.     NewStr := P;
  135.   end;
  136.  
  137.   procedure CleanHexStr(var S : string);
  138.     {-handle ASM- and C-style hex notations}
  139.   var
  140.     SLen : Byte absolute S;
  141.   begin
  142.     while S[SLen] = ' ' do
  143.       Dec(SLen);
  144.     if (SLen > 1) and (Upcase(S[SLen]) = 'H') then begin
  145.       Move(S[1], S[2], SLen-1);
  146.       S[1] := '$';
  147.     end
  148.     else if (SLen > 2) and (S[1] = '0') and (Upcase(S[2]) = 'X') then begin
  149.       Dec(SLen);
  150.       Move(S[3], S[2], SLen-1);
  151.       S[1] := '$';
  152.     end;
  153.   end;
  154.  
  155. {$IFNDEF UseOPro}
  156. {-If we're not using OPro, define the string manipulation routines we need.}
  157.  
  158. const
  159.   Digits : Array[0..$F] of Char = '0123456789ABCDEF';
  160.  
  161.   function HexB(B : Byte) : string;
  162.     {-Return hex string for byte}
  163.   begin
  164.     HexB[0] := #2;
  165.     HexB[1] := Digits[B shr 4];
  166.     HexB[2] := Digits[B and $F];
  167.   end;
  168.  
  169.   function Trim(S : string) : string;
  170.     {-Return a string with leading and trailing white space removed}
  171.   var
  172.     I : Word;
  173.     SLen : Byte absolute S;
  174.   begin
  175.     while (SLen > 0) and (S[SLen] <= ' ') do
  176.       Dec(SLen);
  177.  
  178.     I := 1;
  179.     while (I <= SLen) and (S[I] <= ' ') do
  180.       Inc(I);
  181.     Dec(I);
  182.     if I > 0 then
  183.       Delete(S, 1, I);
  184.  
  185.     Trim := S;
  186.   end;
  187.  
  188.   function StUpcase(S : String) : String;
  189.     {-Convert a string to all uppercase.  Ignores internationalization issues}
  190.   var
  191.     I : Byte;
  192.   begin
  193.     for I := 1 to Length(S) do
  194.       S[i] := Upcase(S[i]);
  195.     StUpcase := S;
  196.   end;
  197. {$ENDIF}
  198.  
  199.   function StripBrackets(S : String) : String;
  200.   var
  201.     B : Byte absolute S;
  202.   begin
  203.     S := Trim(S);
  204.     if S[b] = ']' then
  205.       Dec(B);
  206.     if S[1] = '[' then begin
  207.       Move(S[2], S[1], B-1);
  208.       Dec(B);
  209.     end;
  210.     StripBrackets := StUpcase(S);
  211.   end;
  212.  
  213.   procedure SetEncryptionKey(NewKey : String);
  214.     {-Define the encryption key to use}
  215.   begin
  216.     EncryptionKey := NewKey;
  217.   end;
  218.  
  219.   function Crypt(S : String) : String;
  220.     {-simple self-reversing xor encryption}
  221.   var
  222.     SI, KI : Byte;
  223.     T : String;
  224.   begin
  225.     T := '';
  226.     KI := 1;
  227.     for SI := 1 to Length(S) do begin
  228.       T := T + Chr(Byte(S[SI]) xor Byte(EncryptionKey[KI]));
  229.       Inc(KI);
  230.       if KI > Length(EncryptionKey) then
  231.         KI := 1;
  232.     end;
  233.     Crypt := T;
  234.   end;
  235.  
  236.   function Encrypt(S : String) : String;
  237.     {-Convert S to XOR-encrypted string, then "hex-ize"}
  238.   var
  239.     T, U : String;
  240.     I : Integer;
  241.   begin
  242.     U := '';
  243.     T := Crypt(S);
  244.     for I := 1 to Length(T) do
  245.       U := U + HexB(Byte(T[i]));
  246.     Encrypt := U;
  247.   end;
  248.  
  249.   function Decrypt(S : String) : String;
  250.     {-Convert "hex-ized" string to encrypted raw string, and decrypt}
  251.   var
  252.     T,U : String;
  253.     I,C : Integer;
  254.   begin
  255.     T := '';
  256.     while S <> '' do begin
  257.       U := '$'+Copy(S, 1, 2);
  258.       Delete(S, 1, 2);
  259.       Val(U, I, C);
  260.       T := T + Char(I);
  261.     end;
  262.     Decrypt := Crypt(T);
  263.   end;
  264.  
  265. {---------------------------------------------------------------------------}
  266.  
  267.   constructor TLine.Init(S : String);
  268.   begin
  269.     inherited Init;
  270.     PL := NewStr(S);
  271.   end;
  272.  
  273.   destructor TLine.Done;
  274.   begin
  275.     DisposeStr(PL);
  276.     inherited Done;
  277.   end;
  278.  
  279.   procedure TLine.Update(S : String);
  280.   begin
  281.     DisposeStr(PL);
  282.     PL := NewStr(S);
  283.   end;
  284.  
  285. {---------------------------------------------------------------------------}
  286.  
  287.   constructor TIni.Init(ALimit, ADelta : Integer;
  288.                         FN : String;
  289.                         Sparse, Create : Boolean);
  290.   var
  291.     P : PLine;
  292.     S : String;
  293.   begin
  294.     inherited Init(ALimit, ADelta);
  295.     GetMem(FBufr, FBufSize);
  296.  
  297.     IsSparse := Sparse;
  298.     NeedUpd := False;
  299.     AlwaysUpd := False;
  300.     ExitFlush := False;
  301.  
  302.     {load INI file}
  303.     IniName := FN;
  304.     Assign(IniF, IniName);
  305.     SetTextBuf(IniF, FBufr[0], FBufSize);
  306.     Reset(IniF);
  307.     if IOResult <> 0 then begin
  308.       {file doesn't yet exist; drop out}
  309.       if not Create then begin
  310.         Done;
  311.         Fail;
  312.       end
  313.       else begin
  314.         NeedUpd := True;
  315.         Exit;
  316.       end;
  317.     end;
  318.  
  319.     while not EOF(IniF) do begin
  320.       ReadLn(IniF, S);
  321.       if IOResult <> 0 then begin
  322.         {read error here means something is wrong; bomb it}
  323.         Close(IniF);  if IOresult = 0 then ;
  324.         Done;
  325.         Fail;
  326.       end;
  327.  
  328.       {add the string to the collection}
  329.       S := Trim(S);
  330.       if (not(Sparse)) or ((S <> '') and (S[1] <> ';')) then begin
  331.         New(P, Init(S));
  332.         if P = nil then begin
  333.           {out of memory, bomb it}
  334.           Close(IniF);
  335.           if IOResult = 0 then ;
  336.           Done;
  337.           Fail;
  338.         end;
  339.         Insert(P);
  340.       end;
  341.     end;
  342.     Close(IniF);
  343.     if IOResult = 0 then ;
  344.  
  345.     AlwaysUpd := True;
  346.     ExitFlush := True;
  347.   end;
  348.  
  349.   destructor TIni.Done;
  350.   begin
  351.     if (NeedUpd) and (ExitFlush) then
  352.       FlushFile;
  353.     FreeMem(FBufr, FBufSize);
  354.     inherited Done;
  355.   end;
  356.  
  357.   procedure TIni.Reload;
  358.   var
  359.     P : PLine;
  360.     S : String;
  361.   begin
  362.     FreeAll;
  363.     Assign(IniF, IniName);
  364.     SetTextBuf(IniF, FBufr[0], FBufSize);
  365.     Reset(IniF);
  366.     if IOResult <> 0 then
  367.       Exit;
  368.  
  369.     while not EOF(IniF) do begin
  370.       ReadLn(IniF, S);
  371.       if IOResult <> 0 then begin
  372.         {read error here means something is wrong; bomb it}
  373.         Close(IniF);  if IOresult = 0 then ;
  374.         Exit;
  375.       end;
  376.  
  377.       S := Trim(S);
  378.       if (not(IsSparse)) or ((S <> '') and (S[1] <> ';')) then begin
  379.         New(P, Init(S));
  380.         if P = nil then begin
  381.           {out of memory, bomb it}
  382.           Close(IniF);  if IOResult = 0 then ;
  383.           Exit;
  384.         end;
  385.         Insert(P);
  386.       end;
  387.     end;
  388.     Close(IniF);
  389.     if IOResult = 0 then ;
  390.   end;
  391.  
  392.   procedure TIni.SetFlushMode(Always : Boolean);
  393.   begin
  394.     AlwaysUpd := Always;
  395.   end;
  396.  
  397.   procedure TIni.SetExitFlushMode(DoIt : Boolean);
  398.   begin
  399.     ExitFlush := DoIt;
  400.   end;
  401.  
  402.   procedure TIni.FlushFile;
  403.     {-Force the INI file to be rewritten}
  404.   var
  405.     S : String;
  406.     P : PLine;
  407.     I : Integer;
  408.   begin
  409.     if IsSparse then
  410.       Exit;
  411.  
  412.     Assign(IniF, IniName);
  413.     SetTextBuf(IniF, FBufr[0], FBufSize);
  414.     Rewrite(IniF);
  415.     if IOResult <> 0 then
  416.       Exit;
  417.  
  418.     I := 0;
  419.     while I < Count do begin
  420.       P := PLine(At(I));
  421.       WriteLn(IniF, P^.PL^);
  422.       if IOResult <> 0 then begin
  423.         Close(IniF);
  424.         if IOResult = 0 then ;
  425.         exit;
  426.       end;
  427.       Inc(I);
  428.     end;
  429.  
  430.     Close(IniF);
  431.     if IOResult = 0 then ;
  432.     NeedUpd := False;
  433.   end;
  434.  
  435.   function TIni.GetIniNode(Title, Group : String) : PLine;
  436.     {-Return the Title node in Group, or nil if not found}
  437.   var
  438.     P : PLine;
  439.     S : String;
  440.     I : Integer;
  441.     GroupSeen : Boolean;
  442.   begin
  443.     GetIniNode := nil;
  444.     if Count = 0 then exit;
  445.  
  446.     {fixup strings as needed}
  447.     if Group[1] <> '[' then
  448.       Group := '['+Group+']';
  449.     Group := StUpcase(Group);
  450.     Title := StUpcase(Title);
  451.  
  452.     {search}
  453.     GroupSeen := False;
  454.     I := 0;
  455.     while I < Count do begin
  456.       P := PLine(At(I));
  457.       if P^.PL^[1] = '[' then begin
  458.         {a group header...}
  459.         if StUpcase(P^.PL^) = Group then
  460.           {in our group}
  461.           GroupSeen := True
  462.         else if GroupSeen then
  463.           {exhausted all options in our group; get out}
  464.           exit;
  465.       end
  466.       else if (GroupSeen) and (P^.PL^[1] <> ';') then begin
  467.         {in our group, see if the title matches}
  468.         S := Copy(P^.PL^, 1, Pos('=', P^.PL^)-1);
  469.         S := Trim(S);
  470.         S := StUpcase(S);
  471.         if Title = S then begin
  472.           GetIniNode := P;
  473.           exit;
  474.         end;
  475.       end;
  476.       Inc(I);
  477.     end;
  478.   end;
  479.  
  480.   function TIni.GetLastNodeInGroup(Group : String) : PLine;
  481.     {-Return the last node in Group, or nil if not found}
  482.   var
  483.     P,Q : PLine;
  484.     S : String;
  485.     I : Integer;
  486.     GroupSeen : Boolean;
  487.   begin
  488.     GetLastNodeInGroup := nil;
  489.     if Count = 0 then exit;
  490.  
  491.     {fixup strings as needed}
  492.     if Group[1] <> '[' then
  493.       Group := '['+Group+']';
  494.     Group := StUpcase(Group);
  495.  
  496.     {search}
  497.     GroupSeen := False;
  498.     Q := nil;
  499.     I := 0;
  500.     while I < Count do begin
  501.       P := PLine(At(I));
  502.       if P^.PL^[1] = '[' then begin
  503.         {a group header...}
  504.         if StUpcase(P^.PL^) = Group then
  505.           {in our group}
  506.           GroupSeen := True
  507.         else if (GroupSeen) then begin
  508.           {exhausted all lines in our group, return the last pointer}
  509.           if Q = nil then
  510.             Q := PLine(At(I-1));
  511.           I := IndexOf(Q);
  512.           while (I >= 0) and (PLine(At(I))^.PL^ = '') do
  513.             Dec(I);
  514.           if I < 0 then
  515.             GetLastNodeInGroup := nil
  516.           else
  517.             GetLastNodeInGroup := PLine(At(I));
  518.           exit;
  519.         end;
  520.       end;
  521.       Q := P;
  522.       Inc(I);
  523.     end;
  524.     if GroupSeen then
  525.       GetLastNodeInGroup := Q
  526.     else
  527.       GetLastNodeInGroup := nil;
  528.   end;
  529.  
  530.   function TIni.GetProfilePrim(Title, Group : String) : String;
  531.     {-Primitive to return the string at Title in Group}
  532.   var
  533.     P : PLine;
  534.     S : String;
  535.     B : Byte absolute S;
  536.   begin
  537.     P := GetIniNode(Title, Group);
  538.     if P = nil then
  539.       GetProfilePrim := ''
  540.     else begin
  541.       S := P^.PL^;
  542.       S := Copy(S, Pos('=', S)+1, 255);
  543.       S := Trim(S);
  544.       if (S[1] = '"') and (S[b] = '"') then begin
  545.         Move(S[2], S[1], B-1);
  546.         Dec(B, 2);
  547.       end;
  548.       GetProfilePrim := S;
  549.     end;
  550.   end;
  551.  
  552.   function TIni.KillProfileItem(Title, Group : String) : Boolean;
  553.     {-Removes Title item in Group from the list}
  554.   var
  555.     P : PLine;
  556.   begin
  557.     KillProfileItem := False;
  558.     if IsSparse then Exit;
  559.  
  560.     P := GetIniNode(Title, Group);
  561.     if P <> nil then begin
  562.       Free(P);
  563.       KillProfileItem := True;
  564.       if AlwaysUpd then
  565.         FlushFile
  566.       else
  567.         NeedUpd := True;
  568.     end;
  569.   end;
  570.  
  571.   function TIni.KillProfileGroup(Group : String) : Boolean;
  572.     {-Removes all items in Group from the list}
  573.   var
  574.     P : PLine;
  575.     I : Integer;
  576.     S : String;
  577.   begin
  578.     KillProfileGroup := False;
  579.     if IsSparse then Exit;
  580.  
  581.     {fixup string as needed}
  582.     if Group[1] <> '[' then
  583.       Group := '['+Group+']';
  584.     Group := StUpcase(Group);
  585.  
  586.     {search}
  587.     I := 0;
  588.     while I < Count do begin
  589.       P := PLine(At(I));
  590.       if (P^.PL^[1] = '[') and (StUpcase(P^.PL^) = Group) then begin
  591.         Inc(I);
  592.         while (I < Count) and (PLine(At(I))^.PL^[1] <> '[') do
  593.           Free(At(I));
  594.         Free(P);
  595.         KillProfileGroup := True;
  596.         if AlwaysUpd then
  597.           FlushFile
  598.         else
  599.           NeedUpd := True;
  600.         Exit;
  601.       end;
  602.       Inc(I);
  603.     end;
  604.   end;
  605.  
  606.   function TIni.GetProfileString(Title, Group, Default : String) : String;
  607.     {-Returns Title item in Group, or Default if not found}
  608.   var
  609.    S : String;
  610.   begin
  611.     S := GetProfilePrim(Title, Group);
  612.     if S = '' then
  613.       S := Default;
  614.     GetProfileString := S;
  615.   end;
  616.  
  617.   function TIni.GetEncryptedProfileString(Title, Group, Default : String) : String;
  618.     {-Returns decrypted Title item in Group, or Default if not found}
  619.   var
  620.    S : String;
  621.   begin
  622.     S := GetProfilePrim(Title, Group);
  623.     if S = '' then
  624.       S := Default
  625.     else
  626.       S := DeCrypt(S);
  627.     GetEncryptedProfileString := S;
  628.   end;
  629.  
  630.   function TIni.GetProfileBool(Title, Group : String; Default : Boolean) : Boolean;
  631.   var
  632.     S : String;
  633.   begin
  634.     S := Trim(GetProfilePrim(Title, Group));
  635.     if S <> '' then begin
  636.       S := StUpcase(S);
  637.       if (S = 'TRUE') or (S = '1') or (S = 'Y') or (S = 'YES') or (S = 'ON') then
  638.         GetProfileBool := True
  639.       else if (S = 'FALSE') or (S = '0') or (S = 'N') or (S = 'NO') or (S = 'OFF') then
  640.         GetProfileBool := False
  641.       else
  642.         GetProfileBool := Default;
  643.     end
  644.     else
  645.       GetProfileBool := Default;
  646.   end;
  647.  
  648.   function TIni.GetProfileByte(Title, Group : String; Default : Byte) : Byte;
  649.   var
  650.     S : String;
  651.     C : Integer;
  652.     B : Byte;
  653.   begin
  654.     S := Trim(GetProfilePrim(Title, Group));
  655.     if S <> '' then begin
  656.       CleanHexStr(S);
  657.       Val(S, B, C);
  658.       if C = 0 then
  659.         GetProfileByte := B
  660.       else
  661.         GetProfileByte := Default;
  662.     end
  663.     else
  664.       GetProfileByte := Default;
  665.   end;
  666.  
  667.   function TIni.GetProfileInt(Title, Group : String; Default : Integer) : Integer;
  668.   var
  669.     S : String;
  670.     I,C : Integer;
  671.   begin
  672.     S := Trim(GetProfilePrim(Title, Group));
  673.     if S <> '' then begin
  674.       CleanHexStr(S);
  675.       Val(S, I, C);
  676.       if C = 0 then
  677.         GetProfileInt := I
  678.       else
  679.         GetProfileInt := Default;
  680.     end
  681.     else
  682.       GetProfileInt := Default;
  683.   end;
  684.  
  685.   function TIni.GetProfileWord(Title, Group : String; Default : Word) : Word;
  686.   var
  687.     S : String;
  688.     W : Word;
  689.     C : Integer;
  690.   begin
  691.     S := Trim(GetProfilePrim(Title, Group));
  692.     if S <> '' then begin
  693.       CleanHexStr(S);
  694.       Val(S, W, C);
  695.       if C = 0 then
  696.         GetProfileWord := W
  697.       else
  698.         GetProfileWord := Default;
  699.     end
  700.     else
  701.       GetProfileWord := Default;
  702.   end;
  703.  
  704.   function TIni.GetProfileLong(Title, Group : String; Default : LongInt) : LongInt;
  705.   var
  706.     S : String;
  707.     I : LongInt;
  708.     C : Integer;
  709.   begin
  710.     S := Trim(GetProfilePrim(Title, Group));
  711.     if S <> '' then begin
  712.       CleanHexStr(S);
  713.       Val(S, I, C);
  714.       if C = 0 then
  715.         GetProfileLong := I
  716.       else
  717.         GetProfileLong := Default;
  718.     end
  719.     else
  720.       GetProfileLong := Default;
  721.   end;
  722.  
  723.   function TIni.SetProfileString(Title, Group, NewVal : String) : Boolean;
  724.   var
  725.     S : String;
  726.     P : PLine;
  727.   begin
  728.     SetProfileString := False;
  729.     if IsSparse then exit;
  730.  
  731.     P := GetIniNode(Title, Group);
  732.     if P = nil then
  733.       SetProfileString := AddProfileString(Title, Group, NewVal)
  734.     else begin
  735.       S := P^.PL^;
  736.       System.Delete(S, Pos('=', S)+1, 255);
  737.       S := S + NewVal;
  738.       P^.Update(S);
  739.       SetProfileString := True;
  740.       if AlwaysUpd then
  741.         FlushFile
  742.       else
  743.         NeedUpd := True;
  744.     end;
  745.   end;
  746.  
  747.   function TIni.SetEncryptedProfileString(Title, Group, NewVal : String) : Boolean;
  748.   var
  749.     S : String;
  750.     P : PLine;
  751.   begin
  752.     SetEncryptedProfileString := False;
  753.     if IsSparse then exit;
  754.  
  755.     P := GetIniNode(Title, Group);
  756.     if P = nil then
  757.       SetEncryptedProfileString := AddEncryptedProfileString(Title, Group, NewVal)
  758.     else begin
  759.       S := P^.PL^;
  760.       System.Delete(S, Pos('=', S)+1, 255);
  761.       S := S + EnCrypt(NewVal);
  762.       P^.Update(S);
  763.       SetEncryptedProfileString := True;
  764.       if AlwaysUpd then
  765.         FlushFile
  766.       else
  767.         NeedUpd := True;
  768.     end;
  769.   end;
  770.  
  771.   function TIni.AddProfileString(Title, Group, NewVal : String) : Boolean;
  772.     {-add new node and/or group to the list}
  773.   var
  774.     P : PLine;
  775.     I : Integer;
  776.   begin
  777.     AddProfileString := False;
  778.     if IsSparse then exit;
  779.  
  780.     {fixup strings as needed}
  781.     if Group[1] <> '[' then
  782.       Group := '['+Group+']';
  783.  
  784.     P := GetLastNodeInGroup(Group);
  785.     if P = nil then begin
  786.       {group not found, create a new one}
  787.       {add a blank line for spacing}
  788.       New(P, Init(''));
  789.       if P = nil then Exit;
  790.       Insert(P);
  791.       New(P, Init(Group));
  792.       if P = nil then Exit;
  793.       Insert(P);
  794.       I := Count;
  795.     end
  796.     else
  797.       I := IndexOf(P)+1;
  798.  
  799.     {add our new element after}
  800.     if Title = '' then
  801.       AddProfileString := True
  802.     else begin
  803.       New(P, Init(Title+'='+NewVal));
  804.       if P <> nil then begin
  805.         AtInsert(I, P);
  806.         AddProfileString := True;
  807.         if AlwaysUpd then
  808.           FlushFile
  809.         else
  810.           NeedUpd := True;
  811.       end;
  812.     end;
  813.   end;
  814.  
  815.   function TIni.AddEncryptedProfileString(Title, Group, NewVal : String) : Boolean;
  816.     {-add new encrypted node and/or group to the list}
  817.   var
  818.     P,Q : PLine;
  819.     I : Integer;
  820.   begin
  821.     AddEncryptedProfileString := False;
  822.     if IsSparse then exit;
  823.  
  824.     {fixup strings as needed}
  825.     if Group[1] <> '[' then
  826.       Group := '['+Group+']';
  827.  
  828.     P := GetLastNodeInGroup(Group);
  829.     if P = nil then begin
  830.       {group not found, create a new one}
  831.       {add a blank line for spacing}
  832.       New(P, Init(''));
  833.       if P = nil then Exit;
  834.       Insert(P);
  835.       New(P, Init(Group));
  836.       if P = nil then Exit;
  837.       Insert(P);
  838.       I := Count;
  839.     end
  840.     else
  841.       I := IndexOf(P)+1;
  842.  
  843.     {add our new element after}
  844.     if Title = '' then
  845.       AddEncryptedProfileString := True
  846.     else begin
  847.       New(P, Init(Title+'='+Encrypt(NewVal)));
  848.       if P <> nil then begin
  849.         AtInsert(I, P);
  850.         AddEncryptedProfileString := True;
  851.         if AlwaysUpd then
  852.           FlushFile
  853.         else
  854.           NeedUpd := True;
  855.       end;
  856.     end;
  857.   end;
  858.  
  859.   function TIni.EnumGroups(P : PStringCollection; Clr : Boolean) : Boolean;
  860.     {-Return P loaded with the names of all groups in the file.  Returns
  861.       false only on error.  Uses AtInsert rather than Insert so collection
  862.       items are in file order rather than sorted order.}
  863.   var
  864.     Q : PLine;
  865.     R : PString;
  866.     I : Integer;
  867.   begin
  868.     EnumGroups := False;
  869.     if Clr then
  870.       P^.FreeAll;
  871.  
  872.     I := 0;
  873.     while I < Count do begin
  874.       Q := PLine(At(I));
  875.       if Q^.PL^[1] = '[' then begin
  876.         R := NewStr(StripBrackets(Q^.PL^));
  877.         P^.AtInsert(P^.Count, R);
  878.       end;
  879.       Inc(I);
  880.     end;
  881.     EnumGroups := True;
  882.   end;
  883.  
  884.   function TIni.EnumGroupItems(P : PStringCollection; Group : String; Clr : Boolean) : Boolean;
  885.     {-Return P loaded with all items in group [Group].  Returns false
  886.       if Group not found or error.  Uses AtInsert rather than Insert so
  887.       collection items are in file order rather than sorted order.}
  888.   var
  889.     Q : PLine;
  890.     R : PString;
  891.     S : String;
  892.     I : Integer;
  893.   begin
  894.     EnumGroupItems := False;
  895.     if Clr then
  896.       P^.FreeAll;
  897.  
  898.     {fixup strings as needed}
  899.     if Group[1] <> '[' then
  900.       Group := '['+Group+']';
  901.     Group := StUpcase(Group);
  902.  
  903.     I := 0;
  904.     while I < Count do begin
  905.       Q := PLine(At(I));
  906.       if StUpcase(Q^.PL^) = Group then begin
  907.         Inc(I);
  908.         while (I < Count) and (PLine(At(I))^.PL^[1] <> '[') do begin
  909.           S := Trim(PLine(At(I))^.PL^);
  910.           if (S <> '') and (S[1] <> ';') then begin
  911.             if Pos('=', S) > 0 then
  912.               S[0] := Char(Pos('=', S)-1);
  913.             S := Trim(S);
  914.             R := NewStr(S);
  915.             P^.AtInsert(P^.Count, R);
  916.           end;
  917.           Inc(I);
  918.         end;
  919.         EnumGroupItems := True;
  920.         Exit;
  921.       end;
  922.       Inc(I);
  923.     end;
  924.   end;
  925.  
  926. end.
  927.